Attribute VB_Name = "modMain"
'---------------------------------------------------------------------------------------
'Module : modMain
'Date   : 03/17/2004
'Author : Chris Elwell
'Purpose: 1. Declare project global variables (Non FXRS)
'         2. Formatting routines (numeric, field length, acct# check, etc.)
'         3. Routines for loading combo boxes
'         4. Scale routine
'---------------------------------------------------------------------------------------
'
Option Explicit

Public g_blnComplete As Boolean                     'Set to true after each transaction
Public g_blnBatch As Boolean                        'Set to True when processing batch
Public g_blnMPS As Boolean                          'Set to True after IPD MPS Completes processing
Public g_blnFormLoadComplete As Boolean             'Used to speed up execution of program
Public g_blnAbortBatch As Boolean                   'Used to Abort batch processing
Public g_blnDeletesComplete As Boolean              'Used to control program flow when deleting multiple pkgs using grdShipments
Public g_blnAllowOptimize As Boolean                'Makes txtDelDate field and calendar4 visible for optimization
Public g_blnDoOptimize As Boolean                   'Set to true to select the service automatically
Public g_blnNextClose As Boolean                    'Used to control the flow of FXRS Closes when "ALL" selected
Public g_blnBatchErrorCheck As Boolean              'Used when using Batch Error Check
Public g_blnBatchEdit As Boolean                    'Set to True when processing batch error edit
Public g_blnIPD As Boolean                          'Set to True when IPD is selected
Public g_blnUseLabelFldsInBatch As Boolean          'Set to True to use Label setup in Batch processing
Public g_blnIPDConfirm As Boolean                   'Set to True when confirming an IPD shipment
Public g_blnReturnDelete As Boolean                 'Set to True when deleting an Return labels
Public g_blnBatchReturn As Boolean                  'Set to True when creating Return labels in batch
Public g_blnDebug As Boolean                        'Set to True to turn on transaction debugger
'20070625-01 Added MPS functionality to Service Quote
'Used when showing MPS form
Public g_blnIsQuote As Boolean                      'Set to True when clicking Multi-Piece button on Service Quote form.
'Can't ship while rate in progress
Public g_blnRatePending As Boolean

Public g_intDebugStart As Integer                   'Current starting position for parsing transactions
Public g_lngErrorCount As Long                      'Number of Batch errors
Public g_lngSoftErrorCount As Long                  'Number of Batch Addr Verify soft errors
Public g_lngShipCount As Long                       'Number of Batch Shipments
Public g_strReply As String                         'FXRS Reply string
Public g_strSaveReply As String                     'Saved FXRS Reply string
Public g_intDupCount As Integer                     'Used to count duplicate pkgs
Public g_clsReg As clsRegistryRoutines              'Registry class object
Public Const MAINKEYROOT = "Software\FXRSClient"    'Registry class constant
Public Const MAINSUBKEY = "Settings"                'Registry class constant
Public Const HKEYTYPE = HKEY_LOCAL_MACHINE          'HKEY set to HKEY_CURRENT_USER for Citrix

Public g_connFSMSClient As ADODB.Connection         'Connection to FSMSClient.mdb
Public g_strMappedPath As String                    'Used to save Mapped Path to global var
Public g_strUNCCustomLabels As String               'Used in creating custom labels
Public g_strCUST(10, 10) As String                  'Non FXRS custom label fields
Public g_strTagType As String                       'CT Call Tag or ET Express Tag
Public NASCAR_VERSION As String    'Constant used in DSN settings
Public g_strComputerName As String                  'Computer name set in FormLoad, appended to f1 in multi-occurrence tables

'API routine to get Windows UserID
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'API function to get Computername
 Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal sBuffer As String, lSize As Long) As Long
'API function used in SearchCombo function.
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Public Const CB_FINDSTRING = &H14C

'Delay when doing multiple deletes from Ship History. Increase this value for slow networked installs.
Public Const MULTIPLE_DELETE_DELAY = 1

Public glngThreadID As Long

Public g_rsMPS As ADODB.Recordset

Public g_frmMsgBox As frmMsgBox
Dim m_objFSO As FileSystemObject
'

Public Sub DebugPrint(strMessage As String)

    Debug.Print Now, strMessage
    App.LogEvent strMessage
    
End Sub


'---------------------------------------------------------------------------------------
' Module    : ImpliedDecimal
' DateTime  : 2/13/2004
' Modified  : 4/26/05 - Added code to handle numbers with more decimal places than required
' Author    : Chris Elwell
' Purpose   : Checks for a decimal point in a numeric string and formats to the number of
'             decimal places passed(e.g. 2., 2, 2.0 all formatted to 2.00) The number
'             of decimal places defaults to 2 if not passed.
'             This should be used with fields that have implied decimal places in FXRS.
'             Use the RemoveSpecial function to remove the decimal point
'             when building the FXRS transaction string.
'---------------------------------------------------------------------------------------
'
Public Function ImpliedDecimal(ByVal strText As String, Optional ByVal intPlaces As Integer = 2) As String
    Dim intPosition As Integer
    Dim intLenAfterDecimal As Integer
    Dim i As Integer
    Dim strTemp() As String
    
    On Error GoTo EH
    
    'If string is empty return it empty
    If strText = "" Then
        ImpliedDecimal = ""
        Exit Function
    End If
    
    'Get the position of the decimal point
    intPosition = InStr(1, strText, ".")
    
    'Get the # of digits after the decimal point
    intLenAfterDecimal = Len(Right(strText, Len(strText) - intPosition))
    
    'If no decimal point add number of decimal places requested
    If intPosition = 0 Then
        strText = strText & "."
        For i = 1 To intPlaces
            strText = strText & "0"
        Next
    'If # of digits after decimal < # of requested decimal places add zeros to make up difference
    ElseIf intLenAfterDecimal < intPlaces Then
        strText = Left(strText, intPosition + intLenAfterDecimal)
        For i = 1 To intPlaces - intLenAfterDecimal
            strText = strText & "0"
        Next
    'If number of # of digits afer decimal > # of requested places return string minus extra decimal places
    ElseIf intLenAfterDecimal > intPlaces Then
        strText = Left(strText, Len(strText) - intLenAfterDecimal + intPlaces)
    End If
    
    ImpliedDecimal = strText
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, "modMain:ImpliedDecimal"

End Function
'---------------------------------------------------------------------------------------
' Module    : FormatCharges
' DateTime  : 03/15/2004
' Author    : Chris Elwell
' Purpose   : Formats an FXRS charges reply field string (e.g. fields 34 -37)
'             or surcharges field (e.g. 421 - 430) with 2 decimal places
'---------------------------------------------------------------------------------------
'
Public Function FormatCharges(ByVal strValue As String) As String
    On Error GoTo EH
        
    'If not a number of length < 2 return the orginal string
    If Len(strValue) < 2 Or Not IsNumeric(strValue) Or InStr(strValue, ".") > 0 Then
        FormatCharges = strValue
    Else
        FormatCharges = Left(Trim(strValue), Len(strValue) - 2) & "." & Right(Trim(strValue), 2)
    End If
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, "modMain:FormatCharges"

End Function

Public Function MainFSO() As FileSystemObject
    If m_objFSO Is Nothing Then Set m_objFSO = New FileSystemObject
    Set MainFSO = m_objFSO
End Function

'---------------------------------------------------------------------------------------
' Module    : NumericOnly
' DateTime  : 2/13/2004
' Author    : Chris Elwell
' Purpose   : Allows only numbers and decimal point in the texMyControl passed. Places the
'             cursor at the end of the field after modifying. Use with fields that should
'             only have numeric values.
'---------------------------------------------------------------------------------------
'
Public Function NumericOnly(ByRef MyControl As Control, Optional ByVal blnAllowDecimal As Boolean = True)
    Dim i As Integer
    Dim strNumber As String
    
    On Error GoTo EH
    
    For i = 1 To Len(MyControl)
        If IsNumeric(Mid(MyControl, i, 1)) Or IIf(blnAllowDecimal, Mid(MyControl, i, 1) = ".", False) Then
            strNumber = strNumber & Mid(MyControl, i, 1)
        End If
    Next
    MyControl = strNumber
    MyControl.SelStart = Len(MyControl)

    Exit Function
EH:
     MsgBox Err.Description, vbCritical, "modMain:NumericOnly"

End Function
'---------------------------------------------------------------------------------------
' Module    : NumericValue
' DateTime  : 2/13/2004
' Author    : Chris Elwell
' Purpose   : Safely return a numeric for anything coming in.
'---------------------------------------------------------------------------------------
'
Public Function NumericValue(ByVal TextValue As Variant, Optional ByVal blnAllowDecimal As Boolean = True)
    
    On Error GoTo EH
    
    NumericValue = CDbl(Trim(TextValue))
    If Not blnAllowDecimal Then NumericValue = CLng(NumericValue)
    Exit Function
EH:
    NumericValue = 0
    
End Function
'---------------------------------------------------------------------------------------
' Module    : RemoveSpecial
' DateTime  : 6/2/2004
' Author    : Chris Elwell
' Purpose   : Removes special characters. Allows only alpha-numeric characters.
'---------------------------------------------------------------------------------------
'
Public Function RemoveSpecial(ByRef strSearch As String) As String

     Dim intStrSize As Integer      'Length of the incoming phone string
     Dim i As Integer               'For loop counter
     Dim strDigit As String         'Holds the character being evaluated
     Dim strText As String          'Holds the text to be returned
     
    On Error GoTo EH
     
     'Get length of String passed in
     intStrSize = Len(Trim(strSearch))
     
     'Go through the string one character at a time and if it's numeric add it to strText
     For i = 1 To intStrSize
     strDigit = Mid(Trim(strSearch), i, 1)
         'If The Character Is Numeric Add it to strText
         If IsNumeric(strDigit) Or (Asc(strDigit) >= 65 And Asc(strDigit) <= 90) _
            Or (Asc(strDigit) >= 97 And Asc(strDigit) <= 122) Then
            strText = strText & strDigit
         End If
     Next
     'Return the phone number
     RemoveSpecial = strText
     
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:RemoveSpecial"

End Function
'---------------------------------------------------------------------------------------
' Module        : ReadScale
' DateTime      : 5/11/04
' Modified      : 6/17/05 - added FedEx protocol
' Author        : Chris Elwell
' Purpose       : Function to read a Toldeo scale. Removed rounding code since field 1670
'                 has 2 implied decimal places.
' Requirements  : Pass port (e.g. "1", "2", etc.) as string.
'---------------------------------------------------------------------------------------
'
Public Function ReadScale(ByVal strPort As String, ByVal strProtocol As String) As String
    
    On Error GoTo EH
    
    'Added for FedEx protocol
    'Fedex
    If strProtocol = "1" Then
        ReadScale = ReadFedExScale(strPort)
    'Toledo
    ElseIf strProtocol = "2" Then
        ReadScale = ReadToledoScale(strPort)
    Else
        Exit Function
    End If
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:ReadScale"

End Function
Private Function ReadToledoScale(ByVal strPort As String)
    
    On Error GoTo EH
    
    Dim PauseTime As Single
    Dim Start As Single
    Dim strWeight As String
    
    With frmShip.MSComm1
        .CommPort = CInt(strPort)
        .Settings = "9600,E,7,1"
        .InputLen = 0
        .PortOpen = True
        .Output = "W"
        PauseTime = 5   ' Set timeout duration.
        Start = Timer   ' Set start time.
        'Try to read. Timeout set above
        Do
            DoEvents
            If Timer > PauseTime + Start Then
                strWeight = Chr(2) & "?Timeout" & Chr(13)
            Else
                strWeight = strWeight & .Input
            End If
        Loop Until InStr(1, strWeight, Chr(13)) > 0
        strWeight = Left(strWeight, Len(strWeight) - 1)
        strWeight = Right(strWeight, Len(strWeight) - 1)
        .PortOpen = False
    End With
        
    'Display scale error
    If Left(strWeight, 1) = "?" Then
        Select Case strWeight
            Case "?d"
                MsgBox "Scale weight less than 0", vbExclamation, "Scale Read Error"
            Case "?Timeout"
                MsgBox "Scale read timeout", vbExclamation, "Scale Read Error"
            Case "?i"
                MsgBox "Scale is in motion", vbExclamation, "Scale Read Error"
            Case "?k", "?j"
                MsgBox "Scale maximum weight exceeded", vbExclamation, "Scale Read Error"
            Case Else
                MsgBox "Scale error", vbExclamation, "Scale Read Error"
        End Select
    Else
        g_strScaleMeasure = ""
        If 0 <> InStr(1, strWeight, "KG") Then g_strScaleMeasure = "KGS"
        If 0 <> InStr(1, strWeight, "LB") Then g_strScaleMeasure = "LBS"
        ReadToledoScale = strWeight
    End If
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:ReadToledoScale"

End Function
Private Function ReadFedExScale(ByVal strPort As String)
    
    On Error GoTo EH
    
    Dim PauseTime As Single
    Dim Start As Single
    Dim strWeight As String
    Dim strMeasure As String
    
    ' frmShip.StatusBar1.Panels(2) = ""
    
    With frmShip.MSComm1
        .CommPort = CInt(strPort)
        .Settings = "1200,N,8,1"
        .InputLen = 0
        .PortOpen = True
        .Output = "W" & Chr(13)
        PauseTime = 5   ' Set timeout duration.
        Start = Timer   ' Set start time.
        'Try to read. Timeout set above
        Do
            '20070705-01 Added to allow other processes to continue
            DoEvents
            If Timer > PauseTime + Start Then
                strWeight = "?Timeout" & Chr(10)
            Else
                strWeight = strWeight & .Input
            End If
        Loop Until InStr(1, strWeight, Chr(10)) > 0
    
        ' frmShip.StatusBar1.Panels(2) = frmShip.StatusBar1.Panels(2) & "W" & strWeight

        ' If no error then get weight type
        PauseTime = 1
        If Left(strWeight, 1) <> "?" Then
            Do
                '20070705-01 Added to allow other processes to continue
                DoEvents
                If Timer > PauseTime + Start Then
                    Exit Do
                Else
                    strMeasure = strMeasure & .Input
                End If
            Loop Until InStr(1, strMeasure, Chr(10)) > 0
        End If
        .PortOpen = False
    End With
        
    ' frmShip.StatusBar1.Panels(2) = frmShip.StatusBar1.Panels(2) & "M" & strMeasure
        
    'Display scale error
    If Left(strWeight, 1) = "?" Then
        Select Case strWeight
            Case "?Timeout "
                MsgBox "Scale read timeout", vbExclamation, "Scale Read Error"
            Case Else
                MsgBox "Scale error", vbExclamation, "Scale Read Error"
        End Select
    Else
        g_strScaleMeasure = ""
        If 0 <> InStr(1, strMeasure, "KG") Then g_strScaleMeasure = "KGS"
        If 0 <> InStr(1, strMeasure, "LB") Then g_strScaleMeasure = "LBS"
        ReadFedExScale = strWeight
    End If
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:ReadFedExScale"

End Function
'---------------------------------------------------------------------------------------
' Module    : AccountNumCheckOK
' DateTime  : 2/18/2004
' Author    : Chris Elwell
' Purpose   : Pass an Account# string it returns true if a valid FedEx account format.
'---------------------------------------------------------------------------------------
'
Public Function AcctNumCheckOK(ByVal strAcctNum As String) As Boolean
    Dim intAcctNumArray(8) As Integer
    Dim intTotal As Integer
    Dim intQuotient As Integer
    Dim intRemainder As Integer
    Dim intCheckDigit As Integer
    Dim i As Integer
    
    On Error GoTo EH
    
    'If not correct length return false and exit
    If Len(strAcctNum) <> 9 Then
        AcctNumCheckOK = False
        Exit Function
    End If
    
    intAcctNumArray(1) = Val(Mid(strAcctNum, 1, 1)) * 3
    intAcctNumArray(2) = Val(Mid(strAcctNum, 2, 1)) * 2
    intAcctNumArray(3) = Val(Mid(strAcctNum, 3, 1)) * 7
    intAcctNumArray(4) = Val(Mid(strAcctNum, 4, 1)) * 6
    intAcctNumArray(5) = Val(Mid(strAcctNum, 5, 1)) * 5
    intAcctNumArray(6) = Val(Mid(strAcctNum, 6, 1)) * 4
    intAcctNumArray(7) = Val(Mid(strAcctNum, 7, 1)) * 3
    intAcctNumArray(8) = Val(Mid(strAcctNum, 8, 1)) * 2
    
    'Total products of each digit
    For i = 1 To 8
        intTotal = intTotal + intAcctNumArray(i)
    Next i
    'Mod 11 to get intRemainder
    intRemainder = intTotal Mod 11
    
    'If intRemainder is 1 or 0 check digit = 0, else subtract from 11
    If intRemainder < 2 Then
        intCheckDigit = 0
    Else
        intCheckDigit = 11 - intRemainder
    End If
    
    'Check to see if actual equals calculated check digit
    If Val(Right(strAcctNum, 1)) = intCheckDigit Then
        AcctNumCheckOK = True
    Else
        AcctNumCheckOK = False
    End If
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, "modMain:AcctNumCheckOK"

End Function
'---------------------------------------------------------------------------------------
' Module    : CheckLength
' DateTime  : 2/18/2004
' Author    : Chris Elwell
' Purpose   : Pass a Text box and desired length and this limits length to value passed.
'---------------------------------------------------------------------------------------
'
Public Function CheckLength(ByVal Tbox As TextBox, ByVal intLength As Integer)
    If Len(Tbox) > intLength Then
        Tbox = Left(Tbox, intLength)
        Tbox.SelStart = intLength
    End If
End Function
'---------------------------------------------------------------------------------------
' Module    : SingleQuotes
' DateTime  : 3/8/2004
' Author    : Chris Elwell
' Purpose   : Add single quotes to a string and replaces ' with '' for SQL text fields.
'---------------------------------------------------------------------------------------
'
Public Function SingleQuotes(ByVal strText As String) As String
    SingleQuotes = "'" & Replace(strText, "'", "`") & "'"
End Function
'---------------------------------------------------------------------------------------
' Module    : LoadStates
' DateTime  : 3/16/2004
' Modified  : 7/12/2004 - Added PR
' Author    : Chris Elwell
' Purpose   : Load states into a combo box.
' Call from : Form_Load in frmBSO, frmCOD, frmHAL, frmShip, & frmSetup, and in frmBSO.f1186_Change()
'---------------------------------------------------------------------------------------
'
Public Sub LoadStates(CBox As ComboBox, Optional strCurrent As String)
    
    Dim i As Integer
    
    CBox.Clear
    
    CBox.AddItem "AK - Alaska"
    CBox.AddItem "AL - Alabama"
    CBox.AddItem "AR - Arkansas"
    CBox.AddItem "AZ - Arizona"
    CBox.AddItem "CA - California"
    CBox.AddItem "CO - Colorado"
    CBox.AddItem "CT - Connecticut"
    CBox.AddItem "DC - District of Columbia"
    CBox.AddItem "DE - Delaware"
    CBox.AddItem "FL - Florida"
    CBox.AddItem "GA - Georgia"
    CBox.AddItem "HI - Hawaii"
    CBox.AddItem "IA - Iowa"
    CBox.AddItem "ID - Idaho"
    CBox.AddItem "IL - Illinois"
    CBox.AddItem "IN - Indiana"
    CBox.AddItem "KS - Kansas"
    CBox.AddItem "KY - Kentucky"
    CBox.AddItem "LA - Louisiana"
    CBox.AddItem "MA - Massachusetts"
    CBox.AddItem "MD - Maryland"
    CBox.AddItem "ME - Maine"
    CBox.AddItem "MI - Michigan"
    CBox.AddItem "MN - Minnesota"
    CBox.AddItem "MO - Missouri"
    CBox.AddItem "MS - Mississippi"
    CBox.AddItem "MT - Montana"
    CBox.AddItem "NC - North Carolina"
    CBox.AddItem "ND - North Dakota"
    CBox.AddItem "NE - Nebraska"
    CBox.AddItem "NH - New Hampshire"
    CBox.AddItem "NJ - New Jersey"
    CBox.AddItem "NM - New Mexico"
    CBox.AddItem "NV - Nevada"
    CBox.AddItem "NY - New York"
    CBox.AddItem "OH - Ohio"
    CBox.AddItem "OK - Oklahoma"
    CBox.AddItem "OR - Oregon"
    CBox.AddItem "PA - Pennsylvania"
    CBox.AddItem "RI - Rhode Island"
    CBox.AddItem "SC - South Carolina"
    CBox.AddItem "SD - South Dakota"
    CBox.AddItem "TN - Tennesee"
    CBox.AddItem "TX - Texas"
    CBox.AddItem "UT - Utah"
    CBox.AddItem "VA - Virginia"
    CBox.AddItem "VT - Vermont"
    CBox.AddItem "WA - Washington"
    CBox.AddItem "WI - Wisconsin"
    CBox.AddItem "WV - West Virginia"
    CBox.AddItem "WY - Wyoming"
    CBox.AddItem "PR - Puerto Rico"
    
    For i = 0 To CBox.ListCount - 1
        If Left(CBox.List(i), 2) = Left(strCurrent, 2) Then
            CBox = strCurrent
            Exit For
        End If
    Next


End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadProvinces
' DateTime  : 9/15/2004
' Author    : Chris Elwell
' Purpose   : Load Canadian Provonces into a combo box.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadProvinces(CBox As ComboBox, Optional strCurrent As String)
    
    Dim i As Integer
    
    CBox.Clear
    
    CBox.AddItem "AB - Alberta"
    CBox.AddItem "BC - British Columbia"
    CBox.AddItem "MB - Manitoba"
    CBox.AddItem "NB - New Brunswick"
    CBox.AddItem "NL - Newfoundland"
    CBox.AddItem "NS - Nova Scotia"
    CBox.AddItem "NT - Northwest Territories"
    CBox.AddItem "NU - Nunavut"
    CBox.AddItem "ON - Ontario"
    CBox.AddItem "PE - Prince Edward Island"
    CBox.AddItem "QC - Quebec"
    CBox.AddItem "SK - Saskatchewan"
    CBox.AddItem "YT - Yukon"
    
    For i = 0 To CBox.ListCount - 1
        If Left(CBox.List(i), 2) = Left(strCurrent, 2) Then
            CBox = strCurrent
            Exit For
        End If
    Next

End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadFTRExemptions
' DateTime  : 2/7/2006
' Author    : Chris Elwell
' Purpose   : Loads FTR Exmptions into a combo
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadFTRExemptions(CBox As ComboBox)
    
    CBox.AddItem "[Please Select]"
    CBox.AddItem "NO EEI 30.36"
    CBox.AddItem "NO EEI 30.37(a)"
    CBox.AddItem "NO EEI 30.37(b)"
    CBox.AddItem "NO EEI 30.37(f)"
    CBox.AddItem "NO EEI 30.37(g)"
    CBox.AddItem "NO EEI 30.37(h)"
    CBox.AddItem "NO EEI 30.37(i)"
    CBox.AddItem "NO EEI 30.37(j)"
    CBox.AddItem "NO EEI 30.37(k)"
    CBox.AddItem "NO EEI 30.37(l)"
    CBox.AddItem "NO EEI 30.37(p)"
    CBox.AddItem "NO EEI 30.40(a)"
    CBox.AddItem "NO EEI 30.40(b)"
    CBox.AddItem "NO EEI 30.40(c)"
    CBox.AddItem "NO EEI 30.40(d)"
    CBox.AddItem "NO EEI 30.02(d)"
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadMXStates
' DateTime  : 1/13/2006
' Author    : Chris Elwell
' Purpose   : Load Mexican States into a combo box.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadMXStates(CBox As ComboBox, Optional strCurrent As String)
    
    Dim i As Integer
    
    CBox.Clear
    
    CBox.AddItem "AG - Aguasealientes"
    CBox.AddItem "BC - Baja California"
    CBox.AddItem "BS - Baja California Sur"
    CBox.AddItem "CM - Campeche"
    CBox.AddItem "CS - Chiapas"
    CBox.AddItem "CH - Chihuahua"
    CBox.AddItem "CO - Coahuila"
    CBox.AddItem "CL - Colima"
    CBox.AddItem "DF - Distrito Federal"
    CBox.AddItem "DG - Durango"
    CBox.AddItem "GT - Guanajuanto"
    CBox.AddItem "GR - Guerrero"
    CBox.AddItem "HG - Hidalgo"
    CBox.AddItem "JA - Jalisco"
    CBox.AddItem "MX - Mexico"
    CBox.AddItem "MI - Michoacan"
    CBox.AddItem "MO - Morelos"
    CBox.AddItem "NA - Nayarit"
    CBox.AddItem "NL - Nuevo Leon"
    CBox.AddItem "OA - Oaxaca"
    CBox.AddItem "PU - Puebla"
    CBox.AddItem "QT - Queretaro"
    CBox.AddItem "QR - Quintana Roo"
    CBox.AddItem "SL - San Luis Potosi"
    CBox.AddItem "SI - Sinaloa"
    CBox.AddItem "SO - Sonora"
    CBox.AddItem "TB - Tabasco"
    CBox.AddItem "TM - Tamaulipas"
    CBox.AddItem "TL - Tlaxcala"
    CBox.AddItem "VE - Veracruz"
    CBox.AddItem "YU - Yucatan"
    CBox.AddItem "ZA - Zacatecas"
    
    For i = 0 To CBox.ListCount - 1
        If Left(CBox.List(i), 2) = Left(strCurrent, 2) Then
            CBox = strCurrent
            Exit For
        End If
    Next

End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadCountries
' DateTime  : 3/16/2004
' Author    : Chris Elwell
' Purpose   : Load countries into a combo box.
' Call from : Form_Load in frmBSO, frmCOD, frmHAL, frmShip(4 times)
'---------------------------------------------------------------------------------------
'
Public Sub LoadCountries(CBox As ComboBox)

    CBox.AddItem "AD - ANDORRA"
    CBox.AddItem "AE - UNITED ARAB EMIRATES"
    CBox.AddItem "AF - AFGHANISTAN"
    CBox.AddItem "AG - ANTIGUA"
    CBox.AddItem "AI - ANGUILLA"
    CBox.AddItem "AL - ALBANIA"
    CBox.AddItem "AM - ARMENIA"
    CBox.AddItem "AN - NETHERLANDS ANTILLES"
    CBox.AddItem "AO - ANGOLA"
    CBox.AddItem "AR - ARGENTINA"
    CBox.AddItem "AS - AMERICAN SAMOA"
    CBox.AddItem "AT - AUSTRIA"
    CBox.AddItem "AU - AUSTRALIA"
    CBox.AddItem "AW - ARUBA"
    CBox.AddItem "AZ - AZERBAIJAN"
    CBox.AddItem "BB - BARBADOS"
    CBox.AddItem "BD - BANGLADESH"
    CBox.AddItem "BE - BELGIUM"
    CBox.AddItem "BF - BURKINO FASO"
    CBox.AddItem "BG - BULGARIA"
    CBox.AddItem "BH - BAHRAIN"
    CBox.AddItem "BI - BURUNDI"
    CBox.AddItem "BJ - BENIN"
    CBox.AddItem "BM - BERMUDA"
    CBox.AddItem "BN - BRUNEI"
    CBox.AddItem "BO - BOLIVIA"
    CBox.AddItem "BR - BRAZIL"
    CBox.AddItem "BS - BAHAMAS"
    CBox.AddItem "BT - BHUTAN"
    CBox.AddItem "BW - BOTSWANA"
    CBox.AddItem "BY - BELARUS"
    CBox.AddItem "BZ - BELIZE"
    CBox.AddItem "CA - CANADA"
    CBox.AddItem "CD - CONGO, DEM. REP. OF"
    CBox.AddItem "CF - CENTRAL AFRICAN REPUBLIC"
    CBox.AddItem "CG - CONGO"
    CBox.AddItem "CH - SWITZERLAND"
    CBox.AddItem "CI - IVORY COAST"
    CBox.AddItem "CK - COOK ISLANDS"
    CBox.AddItem "CL - CHILE"
    CBox.AddItem "CM - CAMEROON"
    CBox.AddItem "CN - CHINA"
    CBox.AddItem "CO - COLOMBIA"
    CBox.AddItem "CR - COSTA RICA"
    CBox.AddItem "CV - CAPE VERDE"
    CBox.AddItem "CY - CYPRUS"
    CBox.AddItem "CZ - CZECH REPUBLIC"
    CBox.AddItem "DE - GERMANY"
    CBox.AddItem "DJ - DJIBOUTI"
    CBox.AddItem "DK - DENMARK"
    CBox.AddItem "DM - DOMINICA"
    CBox.AddItem "DO - DOMINICAN REPUBLIC"
    CBox.AddItem "EC - ECUADOR"
    CBox.AddItem "EE - ESTONIA"
    CBox.AddItem "EG - EGYPT"
    CBox.AddItem "ER - ERITREA"
    CBox.AddItem "ES - SPAIN"
    CBox.AddItem "ET - ETHIOPIA"
    CBox.AddItem "FI - FINLAND"
    CBox.AddItem "FJ - FIJI"
    CBox.AddItem "FM - MICRONESIA"
    CBox.AddItem "FO - FAROE ISLAND"
    CBox.AddItem "FR - FRANCE"
    CBox.AddItem "GA - GABON"
    CBox.AddItem "GB - GREAT BRITAIN"
    CBox.AddItem "GD - GRENADA"
    CBox.AddItem "GE - GEORGIA"
    CBox.AddItem "GF - FRENCH GUIANA"
    CBox.AddItem "GH - GHANA"
    CBox.AddItem "GI - GIBRALTAR"
    CBox.AddItem "GL - GREENLAND"
    CBox.AddItem "GM - GAMBIA"
    CBox.AddItem "GN - GUINEA"
    CBox.AddItem "GP - GUADELOUPE"
    CBox.AddItem "GQ - EQUATORIAL GUINEA"
    CBox.AddItem "GR - GREECE"
    CBox.AddItem "GT - GUATEMALA"
    CBox.AddItem "GU - GUAM"
    CBox.AddItem "GY - GUYANA"
    CBox.AddItem "HK - HONG KONG"
    CBox.AddItem "HN - HONDURAS"
    CBox.AddItem "HR - CROATIA"
    CBox.AddItem "HT - HAITI"
    CBox.AddItem "HU - HUNGARY"
    CBox.AddItem "ID - INDONESIA"
    CBox.AddItem "IE - IRELAND"
    CBox.AddItem "IL - ISRAEL"
    CBox.AddItem "IN - INDIA"
    CBox.AddItem "IS - ICELAND"
    CBox.AddItem "IT - ITALY"
    CBox.AddItem "IT - VATICAN CITY"
    CBox.AddItem "IQ - IRAQ"
    CBox.AddItem "JM - JAMAICA"
    CBox.AddItem "JO - JORDAN"
    CBox.AddItem "JP - JAPAN"
    CBox.AddItem "KE - KENYA"
    CBox.AddItem "KG - KYRGYZSTAN"
    CBox.AddItem "KH - CAMBODIA"
    CBox.AddItem "KN - ST KITTS AND NEVIS"
    CBox.AddItem "KR - SOUTH KOREA"
    CBox.AddItem "KW - KUWAIT"
    CBox.AddItem "KY - CAYMAN ISLANDS"
    CBox.AddItem "KZ - KAZAKHSTAN"
    CBox.AddItem "LA - LAOS"
    CBox.AddItem "LB - LEBANON"
    CBox.AddItem "LC - ST LUCIA"
    CBox.AddItem "LI - LIECHTENSTEIN"
    CBox.AddItem "LK - SRI LANKA"
    CBox.AddItem "LR - LIBERIA"
    CBox.AddItem "LS - LESOTHO"
    CBox.AddItem "LT - LITHUANIA"
    CBox.AddItem "LU - LUXEMBOURG"
    CBox.AddItem "LV - LATVIA"
    CBox.AddItem "MA - MOROCCO"
    CBox.AddItem "MC - MONACO"
    CBox.AddItem "MD - MOLDOVA"
    CBox.AddItem "MG - MADAGASCAR"
    CBox.AddItem "MH - MARSHALL ISLANDS"
    CBox.AddItem "MK - MACEDONIA"
    CBox.AddItem "ML - MALI"
    CBox.AddItem "MN - MONGOLIA"
    CBox.AddItem "MO - MACAU"
    CBox.AddItem "MP - SAIPAN"
    CBox.AddItem "MQ - MARTINIQUE"
    CBox.AddItem "MR - MAURITANIA"
    CBox.AddItem "MS - MONTSERRAT"
    CBox.AddItem "MT - MALTA"
    CBox.AddItem "MU - MAURITIUS"
    CBox.AddItem "MV - MALDIVES"
    CBox.AddItem "MW - MALAWI"
    CBox.AddItem "MX - MEXICO"
    CBox.AddItem "MY - MALAYSIA"
    CBox.AddItem "MZ - MOZAMBIQUE"
    CBox.AddItem "NA - NAMIBIA"
    CBox.AddItem "NC - NEW CALEDONIA"
    CBox.AddItem "NE - NIGER"
    CBox.AddItem "NG - NIGERIA"
    CBox.AddItem "NI - NICARAGUA"
    CBox.AddItem "NL - NETHERLANDS"
    CBox.AddItem "NO - NORWAY"
    CBox.AddItem "NP - NEPAL"
    CBox.AddItem "NZ - NEW ZEALAND"
    CBox.AddItem "OM - OMAN"
    CBox.AddItem "PA - PANAMA"
    CBox.AddItem "PE - PERU"
    CBox.AddItem "PF - FRENCH POLYNESIA"
    CBox.AddItem "PG - PAPUA NEW GUINEA"
    CBox.AddItem "PH - PHILIPPINES"
    CBox.AddItem "PK - PAKISTAN"
    CBox.AddItem "PL - POLAND"
    CBox.AddItem "PR - PUERTO RICO"
    CBox.AddItem "PS - PALESTINE AUTONOMOUS"
    CBox.AddItem "PT - PORTUGAL"
    CBox.AddItem "PW - PALAU"
    CBox.AddItem "PY - PARAGUAY"
    CBox.AddItem "QA - QATAR"
    CBox.AddItem "RE - REUNION ISLAND"
    CBox.AddItem "RO - ROMANIA"
    CBox.AddItem "RU - RUSSIA"
    CBox.AddItem "RW - RWANDA"
    CBox.AddItem "SA - SAUDI ARABIA"
    CBox.AddItem "SC - SEYCHELLES"
    CBox.AddItem "SE - SWEDEN"
    CBox.AddItem "SG - SINGAPORE"
    CBox.AddItem "SI - SLOVENIA"
    CBox.AddItem "SK - SLOVAK REPUBLIC"
    CBox.AddItem "SN - SENEGAL"
    CBox.AddItem "SR - SURINAME"
    CBox.AddItem "SV - EL SALVADOR"
    CBox.AddItem "SY - SYRIA"
    CBox.AddItem "SZ - SWAZILAND"
    CBox.AddItem "TC - TURKS & CAICOS ISLANDS"
    CBox.AddItem "TD - CHAD"
    CBox.AddItem "TG - TOGO"
    CBox.AddItem "TH - THAILAND"
    CBox.AddItem "TM - TURKMENISTAN"
    CBox.AddItem "TN - TUNISIA"
    CBox.AddItem "TR - TURKEY"
    CBox.AddItem "TT - TOBAGO & TRINIDAD"
    CBox.AddItem "TW - TAIWAN"
    CBox.AddItem "TZ - TANZANIA"
    CBox.AddItem "UA - UKRAINE"
    CBox.AddItem "UG - UGANDA"
    CBox.AddItem "US - UNITED STATES"
    CBox.AddItem "UY - URUGUAY"
    CBox.AddItem "UZ - UZBEKISTAN"
    CBox.AddItem "VC - ST VINCENT"
    CBox.AddItem "VE - VENEZUELA"
    CBox.AddItem "VG - BRITISH VIRGIN ISLANDS"
    CBox.AddItem "VI - US VIRGIN ISLANDS"
    CBox.AddItem "VN - VIETNAM"
    CBox.AddItem "VU - VANUATU"
    CBox.AddItem "WF - WALLIS & FUTUNA"
    CBox.AddItem "YE - YEMEN ARAB REPUBLIC"
    CBox.AddItem "YU - YUGOSLAVIA"
    CBox.AddItem "ZA - SOUTH AFRICA"
    CBox.AddItem "ZM - ZAMBIA"
    CBox.AddItem "ZW - ZIMBABWE"
End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadCurrencies
' DateTime  : 3/16/2004
' Modified  : 6/12/06 - Updated to FXRS0800 specs
' Author    : Chris Elwell
' Purpose   : Load currency types into a combo box.
' Call from : DomIntlScreenLayout, Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadCurrencies(CBox As ComboBox)
        
        CBox.AddItem "USD" 'US Dollar USD
        CBox.AddItem "ANG" 'Antilles Guilder ANG
        CBox.AddItem "ARA" 'Argentina Austral ARA
        CBox.AddItem "ARN" 'Argentina Peso ARN
        CBox.AddItem "AUD" 'Australian Dollars AUD
        CBox.AddItem "AWG" 'Aruban Florins AWG
        CBox.AddItem "BBD" 'Barbados Dollars BBD
        CBox.AddItem "BHD" 'Bahraini Dinars BHD
        CBox.AddItem "BMD" 'Bermuda Dollars BMD
        CBox.AddItem "BND" 'Brunei Dollar BND
        CBox.AddItem "BRL" 'Brazil Real BRL
        CBox.AddItem "CAD" 'Canadian Dollars CAD
        CBox.AddItem "CHP" 'Chilean Pesos CHP
        CBox.AddItem "CNY" 'Chinese Renminbi CNY
        CBox.AddItem "CYL" 'Cyprus Pounds CYL
        CBox.AddItem "DHS" 'UAE Dirhams DHS
        CBox.AddItem "DKK" 'Denmark Krone DKK
        CBox.AddItem "ECD" 'E. Caribbean Dollars ECD
        CBox.AddItem "EGP" 'Egyptian Pound EGP
        CBox.AddItem "EUR" 'European Currency Unit EUR
        CBox.AddItem "HKD" 'Hong Kong Dollars HKD
        CBox.AddItem "INR" 'Indian Rupees INR
        CBox.AddItem "JAD" 'Jamaican Dollars JAD
        CBox.AddItem "JYE" 'Japanese Yen JYE
        CBox.AddItem "KUD" 'Kuwaiti Dinars KUD
        CBox.AddItem "MOP" 'Macau Patacas MOP
        CBox.AddItem "MYR" 'Malaysian Ringgits MYR
        CBox.AddItem "NMP" 'Mexican Pesos NMP
        CBox.AddItem "NOK" 'Norwegian Kronen NOK
        CBox.AddItem "NTD" 'New Taiwan Dollars NTD
        CBox.AddItem "NZD" 'New Zealand Dollars NZD
        CBox.AddItem "PHP" 'Philippine Pesos PHP
        CBox.AddItem "PKR" 'Pakistan Rupee PKR
        CBox.AddItem "RDD" 'Dominican Peso RDD
        CBox.AddItem "SAR" 'Saudi Arabian Riyals SAR
        CBox.AddItem "SEK" 'Swedish Krona SEK
        CBox.AddItem "SFR" 'Swiss Francs SFR
        CBox.AddItem "SID" 'Singapore Dollars SID
        CBox.AddItem "THB" 'Thailand Baht THB
        CBox.AddItem "TRL" 'Turkish Lira TRL
        CBox.AddItem "TTD" 'Trinidad & Tobago Dollars TTD
        CBox.AddItem "UKL" 'British Pounds UKL
        CBox.AddItem "UYP" 'Uruguay New Pesos UYP
        CBox.AddItem "VEB" 'Venezuela Bolivar VEB
        CBox.AddItem "WON" 'South Korea Won WON
        CBox.AddItem "ZAR" 'South African Rand ZAR
End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadAdmissibilityPkgTypes
' DateTime  : 7/21/2005
' Author    : Chris Elwell
' Purpose   : Load Admissibility Pkg Types for US to CA, CA to US into a combo box.
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadAdmissibilityPkgTypes(CBox As ComboBox)
        
        CBox.AddItem "BOX - Box/Other"
        CBox.AddItem "BAG - Bag"
        CBox.AddItem "BBL - Barrel"
        CBox.AddItem "BSK - Basket"
        CBox.AddItem "BXT - Bucket"
        CBox.AddItem "BDL - Bundle"
        CBox.AddItem "CAG - Cage"
        CBox.AddItem "CTN - Carton"
        CBox.AddItem "CAS - Case"
        CBox.AddItem "CHS - Chest"
        CBox.AddItem "CNT - Container"
        CBox.AddItem "CRT - Crate"
        CBox.AddItem "CYL - Cylinder"
        CBox.AddItem "DRM - Drum"
        CBox.AddItem "ENV - Envelope"
        CBox.AddItem "PKG - Package"
        CBox.AddItem "PAL - Pail"
        CBox.AddItem "PLT - Pallet"
        CBox.AddItem "PCL - Parcel"
        CBox.AddItem "PCS - Pieces"
        CBox.AddItem "REL - Reel"
        CBox.AddItem "ROL - Roll"
        CBox.AddItem "SAK - Sack"
        CBox.AddItem "SHW - Shrink Wrap"
        CBox.AddItem "SKD - Skid"
        CBox.AddItem "TNK - Tank"
        CBox.AddItem "TBN - Tote Bin"
        CBox.AddItem "TBE - Tube"
        CBox.AddItem "UNT - Unit"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadMetersCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 2/18/2004
' Purpose   : Loads Meter # into Meter # combo. Pass the field name and
'             text of the selected meter.
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadMetersCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)

    Dim strQuery As String
    Dim rsMeters As New ADODB.Recordset
    
    On Error GoTo EH
    
    strQuery = "SELECT f498 FROM Meters group by f498 order by f498"
    rsMeters.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    Do While Not rsMeters.EOF
        MyCombo.AddItem rsMeters("f498")
        
        rsMeters.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsMeters.State = adStateOpen Then rsMeters.Close
    Set rsMeters = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadMetersCombo"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadAddrIDCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 2/2/2005
' Purpose   : Loads the AddrID combo
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadAddrIDCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)

    Dim strQuery As String
    Dim rsAddrID As New ADODB.Recordset
    
    On Error GoTo EH
    
    strQuery = "SELECT AddrID FROM AltReturnAddr"
    rsAddrID.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    MyCombo.AddItem "[Create New]"
    
    Do While Not rsAddrID.EOF
        MyCombo.AddItem rsAddrID!AddrID
        
        rsAddrID.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsAddrID.State = adStateOpen Then rsAddrID.Close
    Set rsAddrID = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadAddrIDCombo"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadAcctNumCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 6/10/2004
' Purpose   : Loads Meter # into Meter # combo. Pass the field name and
'             text of the selected meter.
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadAcctNumCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)

    Dim strQuery As String
    Dim rsMeters As New ADODB.Recordset
    
    On Error GoTo EH
    
    strQuery = "SELECT f10 FROM Meters group by f10 order by f10"
    rsMeters.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    Do While Not rsMeters.EOF
        MyCombo.AddItem rsMeters!f10
        
        rsMeters.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsMeters.State = adStateOpen Then rsMeters.Close
    Set rsMeters = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadAcctNumCombo"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadProfileCombo()
' DateTime  : 6/9/2004
' Purpose   : Loads the Profile names into Profile combo on Batch Default tab.
'---------------------------------------------------------------------------------------
'
Public Sub LoadProfileCombo(ByRef MyCombo As ComboBox, ByVal strSelected As String)

    Dim strQuery As String
    Dim rsProfile As New ADODB.Recordset
    
    On Error GoTo EH
    
    strQuery = "SELECT ProfileName FROM BatchProfiles"
    rsProfile.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    If MyCombo.name <> "cboBatchProfile" Then
        MyCombo.AddItem "[Create New]"
    End If
    
    Do While Not rsProfile.EOF
        MyCombo.AddItem rsProfile!ProfileName
        rsProfile.MoveNext
    Loop
    
    MyCombo = strSelected
    
Release:
    If rsProfile.State = adStateOpen Then rsProfile.Close
    Set rsProfile = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadProfileCombo"
    Resume Release

End Sub

'---------------------------------------------------------------------------------------
' Procedure : LoadNameCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 6/10/2004
' Purpose   : Loads Meter # into Meter # combo. Pass the field name and
'             text of the selected meter.
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadNameCombo(ByRef MyCombo As ComboBox, ByVal strSelected As String)

    Dim strQuery As String
    Dim rsMeters As New ADODB.Recordset
    Dim lngIndex As Long
    
    On Error GoTo EH
    
    strQuery = "SELECT Name FROM Meters group by Name order by Name"
    rsMeters.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    lngIndex = -1
    
    'Only add Create New to frmSetup.cboName
    If MyCombo.name = "cboName" Then
        MyCombo.AddItem "[Create New]"
    End If
    
    Do While Not rsMeters.EOF
        MyCombo.AddItem rsMeters("Name")
        If LCase(rsMeters("Name")) = LCase(strSelected) Then
            lngIndex = MyCombo.ListCount - 1
        End If
        rsMeters.MoveNext
    Loop
    
    If strSelected <> "" Then
        MyCombo = strSelected
        If lngIndex < 0 Then
            MyCombo = ""
            Err.Raise 12345, "", "Invalid value, " & strSelected & "."
        End If
        ' 2010-09-08, JFW
        ' MyCombo.ListIndex = lngIndex
    End If
    
Release:
    If rsMeters.State = adStateOpen Then rsMeters.Close
    Set rsMeters = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadNameCombo"
    Resume Release
    Resume
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadBoxDIMsCombos()
' DateTime  : 4/8/2004
' Purpose   : Load Box names in to DIM combos on frmShip, frmMPS
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadBoxDIMsCombos(ByRef MyCombo As ComboBox, Optional ByVal strSelected As String)
    Dim rsBoxes As New ADODB.Recordset
    
    On Error GoTo EH
    
    rsBoxes.Open "SELECT BoxName FROM Dimensions", g_connFSMSClient, adOpenStatic, adLockOptimistic
    If rsBoxes.EOF Then
        MyCombo.Visible = False
    Else
        MyCombo.Clear
        MyCombo.Visible = True
        Do Until rsBoxes.EOF
            MyCombo.AddItem rsBoxes!BoxName
            rsBoxes.MoveNext
        Loop
    End If

    MyCombo = strSelected
Release:
    If rsBoxes.State = adStateOpen Then rsBoxes.Close
    Set rsBoxes = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadBoxDIMsCombos"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadAddrFields()
' DateTime  : 1/30/2006
' Purpose   : Loads recipient info onto form passed in frmTheForm parameter.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function LoadAddrFields(ByVal strLookupFld As String, ByVal strValue As String, ByVal frmTheForm As Form) As Boolean
    On Error GoTo EH
    
    Dim strQuery As String
    Dim rsCustomer As New ADODB.Recordset
    
    strQuery = "SELECT * FROM AddressBook WHERE " & strLookupFld & " = " & SingleQuotes(strValue)
    rsCustomer.Open strQuery, g_connFSMSClient, adOpenKeyset, adLockOptimistic
    With frmTheForm
        If Not rsCustomer.EOF Then
            '7/28/06 Added & "" in case a value is NULL
            .cboCustID = rsCustomer!CustID & ""
            .f1 = rsCustomer!CustID & ""
            .f50 = rsCustomer!f50 & ""
            .cboCompany = rsCustomer!f11 & ""
            .cboContact = rsCustomer!f12 & ""
            .f11 = rsCustomer!f11 & ""
            .f12 = rsCustomer!f12 & ""
            .f13 = rsCustomer!f13 & ""
            .f14 = rsCustomer!f14 & ""
            .f15 = rsCustomer!f15 & ""
            .f16 = rsCustomer!f16 & ""
            .f17 = rsCustomer!f17 & ""
            .f18 = rsCustomer!f18 & ""
            .f23 = rsCustomer!f23 & ""
            .f20 = rsCustomer!f20 & ""
            frmEmail.f1202 = rsCustomer!f1202 & ""
            .f440 = rsCustomer!f440 & ""
            .f1358 = rsCustomer!f118 & ""                       ' TaxID
            .chkAddAddress.Caption = "Update Address Book"
            LoadAddrFields = True
        Else
            .chkAddAddress.Caption = "Add To Address Book"
        End If
    End With
    
Release:
    If rsCustomer.State = adStateOpen Then rsCustomer.Close
    Set rsCustomer = Nothing
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadAddrFields"
    Resume Release

End Function
'---------------------------------------------------------------------------------------
' Procedure : LoadAddrLookupCombos()
' DateTime  : 8/31/2004
' Purpose   : Loads Customer ID, Contact, and Company combos. Pass combo name and
'             lookup field.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadAddrLookupCombos(ByRef MyCombo As ComboBox, ByVal strSelected As String, Optional ByVal strLookupFld As String)

    Dim rsAddrField As New ADODB.Recordset
    Dim strQuery As String

    On Error GoTo EH

    strQuery = "SELECT " & strLookupFld & " FROM AddressBook ORDER BY " & strLookupFld & " ASC"

    rsAddrField.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    If Not rsAddrField.EOF Then
        MyCombo.Clear
        Do Until rsAddrField.EOF
            '7/28/06 Added in case a value is NULL
            If rsAddrField.Fields(0) <> "" And Not IsNull(rsAddrField.Fields(0)) Then
                MyCombo.AddItem rsAddrField.Fields(0)
            End If
            rsAddrField.MoveNext
        Loop
    End If

    MyCombo = strSelected

Release:
    If rsAddrField.State = adStateOpen Then rsAddrField.Close
    Set rsAddrField = Nothing

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadAddrLookupCombos"

    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadAltReturnAddrForm()
' DateTime  : 1/30/2006
' Purpose   : Gets Return Addr info from database and populates Return Addr fields.
'---------------------------------------------------------------------------------------
'
Public Sub LoadReturnAddrForm(ByVal strFieldName As String, ByVal strFieldValue As String, ByVal frmTheForm As Form)

    Dim strQuery As String
    Dim rsRetAddr As New ADODB.Recordset
    
    On Error GoTo EH
    
    strQuery = "SELECT * FROM AltReturnAddr WHERE " & strFieldName & " = " & SingleQuotes(strFieldValue)
    rsRetAddr.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    With frmTheForm
        If Not rsRetAddr.BOF Or Not rsRetAddr.EOF Then
            .cboAddrID.Text = rsRetAddr!AddrID & ""
            .f32.Text = rsRetAddr!f1485 & ""      'Contact
            .f4.Text = rsRetAddr!f1486 & ""       'Company
            .f5.Text = rsRetAddr!f1487 & ""       'Addr1
            .f6.Text = rsRetAddr!f1488 & ""       'Addr2
            .f7.Text = rsRetAddr!f1489 & ""       'City
            .f8.Text = rsRetAddr!f1490 & ""       'St
            .f9.Text = rsRetAddr!f1491 & ""       'Zip
            .f117.Text = rsRetAddr!f1585 & ""     'Country
            .f183.Text = rsRetAddr!f1492 & ""     'Phone
        End If
    End With

Release:
    If rsRetAddr.State = adStateOpen Then rsRetAddr.Close
    Set rsRetAddr = Nothing
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, "frmSetup.LoadAltReturnAddrForm"
    Resume Release
    Resume
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadDeptCombo()
' DateTime  : 2/10/2005
' Purpose   : Loads Department combo
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadDeptCombo(ByRef MyCombo As ComboBox, ByVal strSelected As String)
    Dim rsDept As New ADODB.Recordset
    
    On Error GoTo EH
    
    rsDept.Open "SELECT * FROM Departments ORDER BY Department ASC", g_connFSMSClient, adOpenStatic, adLockOptimistic
    If Not rsDept.EOF Then
        MyCombo.Clear
        Do Until rsDept.EOF
            MyCombo.AddItem rsDept.Fields(0)
            rsDept.MoveNext
        Loop
    End If
    
    MyCombo = strSelected

Release:
    If rsDept.State = adStateOpen Then rsDept.Close
    Set rsDept = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmShip:LoadDeptCombo"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : SetLookup()
' DateTime  : 11/04/2005
' Purpose   : Replaces SetAddressLookup and SetInteractiveLookup. Shows fields for
'             Interactive or Address book processing.
'---------------------------------------------------------------------------------------
'
Public Sub SetLookup(ByVal blnInteractive, ByVal frmTheForm As Form)
    
    With frmTheForm
        .f1.Visible = IIf(blnInteractive, True, False)
        .f11.Visible = IIf(blnInteractive, True, False)
        .f12.Visible = IIf(blnInteractive, True, False)
        .cboCustID.Visible = IIf(blnInteractive, False, True)
        .cboContact.Visible = IIf(blnInteractive, False, True)
        .cboCompany.Visible = IIf(blnInteractive, False, True)
        If Not blnInteractive Then
            Call LoadAddrLookupCombos(.cboCustID, .cboCustID, "CustID")
            Call LoadAddrLookupCombos(.cboContact, .cboContact, "f12")
            Call LoadAddrLookupCombos(.cboCompany, .cboCompany, "f11")
            If .cboCustID.Enabled And g_blnFormLoadComplete Then .cboCustID.SetFocus
        End If
        
        .Label1(1) = IIf(blnInteractive, "Order ID:", "Customer ID:")
        .Label1(1).ToolTipText = "Ctrl-A/double-click to " & IIf(blnInteractive, "AddressBook", "order entry")
        
        .Label1(1).FontBold = IIf(blnInteractive, False, True)
        '10/6/05 only set focus If locked
        .chkAddAddress.Visible = IIf(blnInteractive, False, True)
        '11/04/05 Save last used AddressBook or Order ID to reg
        g_clsReg.SetRegistryValue "AddressBook", IIf(blnInteractive, "0", "1"), REG_SZ
    End With

End Sub
'---------------------------------------------------------------------------------------
' Procedure : RoundUp
' DateTime  : 07/29/2003
' Written by: Keith Thomas
' Purpose   : Rounds weights up if not 0 after decimal, e.g. 1.1 rounded to 2.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function RoundUp(strWeight As String) As String
    
    Dim lngWeight As Long
    
    On Local Error GoTo EH
    If strWeight = "" Then
        RoundUp = ""
        Exit Function
    End If
    
    lngWeight = CLng(strWeight)
    
    If lngWeight < CDbl(strWeight) Then
        lngWeight = lngWeight + 1
    End If
    
    RoundUp = Trim(Str(lngWeight))
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, "modMain:RoundUp"

End Function
'---------------------------------------------------------------------------------------
' Module    : GetRateError
' DateTime  : 6/11/2004
' Author    : Chris Elwell
' Purpose   : Return Error Message for passed rating error code.
' Call from : frmShip.g_clsParser_ParseComplete, FSMSQuote.m_clsFXRS_ParseComplete
'---------------------------------------------------------------------------------------
'
Public Function GetRateError(ByVal strErrorCode As String) As String
    Dim strQuery As String
    Dim rsError As New ADODB.Recordset
    
    On Error GoTo EH
    
    strQuery = "SELECT ErrorMessage FROM RatingErrors WHERE ErrorCode = " & SingleQuotes(strErrorCode)
    rsError.Open strQuery, g_connFSMSClient, adOpenKeyset, adLockOptimistic
    
    If Not rsError.EOF Then
        GetRateError = rsError!ErrorMessage
    Else
        GetRateError = "Unknown Error - " & strErrorCode
    End If
    
Release:
    If rsError.State = adStateOpen Then rsError.Close
    Set rsError = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:GetRateError"
    Resume Release
    
End Function
'---------------------------------------------------------------------------------------
' Module    : SearchCombo
' DateTime  : 8/31/2004
' Author    : Chris Elwell
' Purpose   : Searches a combo for a string
'---------------------------------------------------------------------------------------
'
Public Function SearchCombo(ByRef MyCombo As ComboBox, ByRef intKey As Integer)

    On Error GoTo EH

    Dim lngIndex As Long
    Dim strTemp As String
    Dim sText As String
    Dim lText As Long
    
    If MyCombo.SelStart = 0 Then
        strTemp = MyCombo.Text & Chr(intKey)
    Else
        strTemp = Left(MyCombo.Text, MyCombo.SelStart) & Chr(intKey)
    End If

    'Search the entire combo for string
    lngIndex = SendMessage(MyCombo.hwnd, CB_FINDSTRING, -1, strTemp)

    'If not found lngIndex = -1
    '20070809-01 Overflow error occurs when setting index higher than 32767
    If lngIndex <> -1 And lngIndex < 32768 Then
        MyCombo.Text = MyCombo.List(lngIndex)
        MyCombo.SelStart = Len(strTemp)
        MyCombo.SelLength = Len(MyCombo.List(lngIndex)) - Len(strTemp)
        intKey = 0
    End If

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:SearchCombo"

End Function
'---------------------------------------------------------------------------------------
' Module    : SetComboSelection
' DateTime  : 8/9/2004
' Author    : Chris Elwell
' Purpose   : Use when assigning values to combo boxes. Pass a combo box and value and
'             it checks the value passed against the list, if found it show the entire
'             text. Used with Service type, Pkg type, payment type, etc.
'---------------------------------------------------------------------------------------
'
Public Function SetComboSelection(ByRef MyCombo As ComboBox, ByVal strVal As String)
    
    On Error GoTo EH
    
    Dim i As Integer
    
    For i = 0 To MyCombo.ListCount - 1
        If UCase(Left(MyCombo.List(i), Len(strVal))) = UCase(strVal) Then
            MyCombo.ListIndex = i
            Exit For
        End If
    Next

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:SetComboSelection"
    
    
End Function
'---------------------------------------------------------------------------------------
' Module    : SelectAllText
' DateTime  : 11/01/2005
' Author    : Chris Elwell
' Purpose   : Selects all text in the textbox passed
'---------------------------------------------------------------------------------------
'
Public Function SelectAllText(ByRef MyTBox As TextBox)

    MyTBox.SelStart = 0
    MyTBox.SelLength = Len(MyTBox.Text)
    
End Function
'---------------------------------------------------------------------------------------
' Module    : Pause
' DateTime  : 11/17/2005
' Author    : Chris Elwell
' Purpose   : Routine to use if you need to pause in a routine. Pass # of seconds to pause.
'             Updated to Single to allow partial seconds to be passed.
'---------------------------------------------------------------------------------------
'
Public Sub Pause(ByVal PauseTime As Single)
    
    On Error GoTo EH
    
    Dim StartTime As Single
    
    StartTime = Timer
    
    Do Until Timer > StartTime + PauseTime
        DoEvents
    Loop

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:Pause"
    
End Sub


'---------------------------------------------------------------------------------------
' Module    : Pause
' DateTime  : 11/17/2005
' Author    : Chris Elwell
' Purpose   : Routine to use if you need to pause in a routine. Pass # of seconds to pause.
'             Updated to Single to allow partial seconds to be passed.
'---------------------------------------------------------------------------------------
'
Public Sub PauseMicro(ByVal PauseTime As Single)
    
    On Error GoTo EH
    
    Dim i As Long
    
    For i = 1 To PauseTime
        DoEvents
    Next

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:Pause"
    
End Sub
'

'---------------------------------------------------------------------------------------
' Module    : GetClientDatabaseType
' DateTime  : 8/18/2014
' Author    : Joseph Weir
' Purpose   : Returns the Client database type from the connection string.
'---------------------------------------------------------------------------------------
'
Public Function GetClientDatabaseType() As String
    
    On Error GoTo EH
    
    If 0 <> InStr(1, LCase(g_connFSMSClient.ConnectionString), "sql server") Then
        GetClientDatabaseType = "SQL"
    ElseIf 0 <> InStr(1, LCase(g_connFSMSClient.ConnectionString), ".mdb") Then
        GetClientDatabaseType = "Access"
    ElseIf 0 <> InStr(1, LCase(g_connFSMSClient.ConnectionString), ".accdb") Then
        GetClientDatabaseType = "Access"
    End If

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:GetClientDatabaseType"
    
End Function
'

'---------------------------------------------------------------------------------------
' Module    : GetUserID
' DateTime  : 8/30/2004
' Author    : Chris Elwell
' Purpose   : Returns the Windows Logon ID. Requires API function declaration.
'---------------------------------------------------------------------------------------
'
Public Function GetUserID() As String
    
    On Error GoTo EH
    
    Dim strUserID As String
    Dim lngUIDLen As Long
    Dim n As Long
    
    strUserID = Space(255)
    lngUIDLen = 255
    n = GetUserName(strUserID, lngUIDLen)

    If n <> 0 Then
        GetUserID = Left(strUserID, lngUIDLen - 1)
    Else
        GetUserID = ""
    End If

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:GetUserID"
    
End Function
'

'---------------------------------------------------------------------------------------
' Module    : GetSystemName
' DateTime  : 2/24/2005
' Author    : Chris Elwell
' Purpose   : Returns the Computer name. Requires API function declaration.
'---------------------------------------------------------------------------------------
'
Public Function GetSystemName() As String
    
    On Error GoTo EH
    
    Dim strName As String
    Dim lngNameSize As Long
    Dim lng As Long
    
    strName = Space(16)
    lngNameSize = Len(strName)
    lng = GetComputerName(strName, lngNameSize)
    
    GetSystemName = RemoveSpecial(strName)

    Exit Function

EH:
    MsgBox Err.Description, vbCritical, "modMain:GetSystemName"
   
End Function

'---------------------------------------------------------------------------------------
' Module    : ResizeAll
' DateTime  : 1/27/2005
' Author    : Chris Elwell
' Purpose   : Resizes controls on a form to ratio of old form size to new form size.
' Called    : Called from Form_Load in frmShip if screen resolution is 800X600.
'---------------------------------------------------------------------------------------
'
Public Function ResizeAll(FormName As Form)
    Dim tmpControl As Control
    Dim lngPrevWidth As Long
    Dim lngPrevHeight As Long
    
    On Error Resume Next
    
    lngPrevWidth = 800
    lngPrevHeight = 600
    
    For Each tmpControl In FormName
        If TypeOf tmpControl Is Line Then
            tmpControl.X1 = tmpControl.X1 / lngPrevWidth * FormName.ScaleWidth
            tmpControl.X2 = tmpControl.X2 / lngPrevWidth * FormName.ScaleWidth
            tmpControl.Y1 = tmpControl.Y1 / lngPrevHeight * FormName.ScaleHeight
            tmpControl.Y2 = tmpControl.Y2 / lngPrevHeight * FormName.ScaleHeight
        Else
            If Left(tmpControl.name, 10) = "fraScreens" Then
                tmpControl.Left = 15
                tmpControl.Top = 315
                tmpControl.Width = tmpControl.Width / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Height = tmpControl.Height / lngPrevHeight * FormName.ScaleHeight
            ElseIf tmpControl.name = "WebBrowser1" Then
                tmpControl.Left = 120
                tmpControl.Top = 360
                tmpControl.Width = tmpControl.Width / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Height = tmpControl.Height / lngPrevHeight * FormName.ScaleHeight
            Else
                tmpControl.Left = tmpControl.Left / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Top = tmpControl.Top / lngPrevHeight * FormName.ScaleHeight
                tmpControl.Width = tmpControl.Width / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Height = tmpControl.Height / lngPrevHeight * FormName.ScaleHeight
            End If
        End If
    Next tmpControl

End Function
'---------------------------------------------------------------------------------------
' Module    : SetEmptyBackcolor
' DateTime  : 6/29/2005
' Author    : Chris Elwell
' Purpose   : Pass a textbox and if empty sets the backcolor to orange for required fields.
'---------------------------------------------------------------------------------------
'
Public Sub SetEmptyBackcolor(MyControl As Control)
    MyControl.BackColor = IIf(MyControl = "", &HC0E0FF, &HFFFFFF)
End Sub
'---------------------------------------------------------------------------------------
' Module    : SetBackcolor
' DateTime  : 9/8/2005
' Author    : Chris Elwell
' Purpose   : Pass a textbox and the backcolor is set to the value passed.
'---------------------------------------------------------------------------------------
'
Public Sub SetBackcolor(MyControl As Control, lngColor As Long)
    MyControl.BackColor = lngColor
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GridShiftSelect
' DateTime  : 2/20/2006
' Purpose   : Select a range of rows in a datagrid
'---------------------------------------------------------------------------------------
'
Public Sub GridShiftSelect(ByVal dGrid As DataGrid, ByVal intPrevious As Integer, ByVal intCurrent As Integer)
   
    Dim i As Integer
    Dim intStep As Integer
    
    intStep = IIf(intPrevious < intCurrent, 1, -1)
    
    For i = intPrevious To intCurrent Step intStep
        dGrid.SelBookmarks.Add dGrid.RowBookmark(i)
    Next

End Sub
'---------------------------------------------------------------------------------------
' Procedure : SaveAltReturnAddr()
' DateTime  : 5/11/2006
' Purpose   : Adds Alt Return Addr info to the AltReturnAddr table in database.
' Call from : cmdSave_Click
'---------------------------------------------------------------------------------------
'
Public Sub SaveAltReturnAddr(ByVal AddrID As String, ByVal f1485 As String, ByVal f1486 As String, _
                              ByVal f1487 As String, ByVal f1488 As String, ByVal f1489 As String, _
                              ByVal f1490 As String, ByVal f1491 As String, ByVal f1585 As String, _
                              ByVal f1492 As String)
    
    Dim strQuery As String
    Dim rsAddr As New ADODB.Recordset
    
    On Error GoTo EH
    
    'Check to ensure a new name is entered
    If AddrID = "[Create New]" Then
        MsgBox "Please rename the Address ID and click Save", vbExclamation, "Address Save Error"
        Exit Sub
    '20070917-01 Added code to SaveAltReturnAddr to exit sub if the AddrID is empty.
    ElseIf AddrID = "" Then
        Exit Sub
    End If
    
    strQuery = "SELECT AddrID FROM AltReturnAddr WHERE AddrID = " & SingleQuotes(AddrID)
    rsAddr.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    'If meter # doesn't exist add it
    If rsAddr.EOF Then
        strQuery = "INSERT INTO AltReturnAddr VALUES("
        strQuery = strQuery + SingleQuotes(AddrID) + ","
        strQuery = strQuery + SingleQuotes(f1485) + ","
        strQuery = strQuery + SingleQuotes(f1486) + ","
        strQuery = strQuery + SingleQuotes(f1487) + ","
        strQuery = strQuery + SingleQuotes(f1488) + ","
        strQuery = strQuery + SingleQuotes(f1489) + ","
        strQuery = strQuery + SingleQuotes(f1490) + ","
        strQuery = strQuery + SingleQuotes(f1491) + ","
        strQuery = strQuery + SingleQuotes(Left(f1585, 2)) + ","
        strQuery = strQuery + SingleQuotes(f1492) + ")"
        
        g_connFSMSClient.Execute strQuery
    'Else update it
    Else
        strQuery = "UPDATE AltReturnAddr SET [AddrID] = " + SingleQuotes(AddrID) + ","
        strQuery = strQuery + "[f1485] = " + SingleQuotes(f1485) + ","
        strQuery = strQuery + "[f1486] = " + SingleQuotes(f1486) + ","
        strQuery = strQuery + "[f1487] = " + SingleQuotes(f1487) + ","
        strQuery = strQuery + "[f1488] = " + SingleQuotes(f1488) + ","
        strQuery = strQuery + "[f1489] = " + SingleQuotes(f1489) + ","
        strQuery = strQuery + "[f1490] = " + SingleQuotes(Left(f1490, 2)) + ","
        strQuery = strQuery + "[f1491] = " + SingleQuotes(f1491) + ","
        strQuery = strQuery + "[f1585] = " + SingleQuotes(Left(f1585, 2)) + ","
        strQuery = strQuery + "[f1492] = " + SingleQuotes(f1492)
        strQuery = strQuery + " WHERE AddrID = " + SingleQuotes(AddrID)
        g_connFSMSClient.Execute strQuery
    End If
    
Release:
    If rsAddr.State = adStateOpen Then rsAddr.Close
    Set rsAddr = Nothing
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, "frmSetup.SaveAltReturnAddr"
    Resume Release
    Resume
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : SendTestBuffer
' DateTime  : 10/16/2006
' Author    : Chris Elwell
' Purpose   : Called from the Peripherals tab Test Print button.
'---------------------------------------------------------------------------------------
'
Public Sub SendTestBuffer()
    On Error GoTo EH:
    
    Dim FSO As New FileSystemObject
    Dim TSO As TextStream
    Dim strFileSpec As String
        
    'Create Filespec
    strFileSpec = App.Path & "\EltronTest.txt"
    
    'Build first label and copy to printer UNC
    Set TSO = FSO.CreateTextFile(strFileSpec, True)
    
    If g_str187 = "199" Or g_str187 = "299" Or g_str187 = "399" Or g_str187 = "499" Then
        TSO.Write BuildEltronTestBuffer
    Else
        TSO.Write BuildZebraTestBuffer
    End If
    
    TSO.Close
    
    'Only print and delete if UNC not blank
    If g_str537 <> "" Then
        FSO.CopyFile strFileSpec, g_str537
    End If
    If g_strUNCCustomLabels <> "" Then
        FSO.CopyFile strFileSpec, g_strUNCCustomLabels
    End If
    FSO.DeleteFile strFileSpec
    
Release:
    Set TSO = Nothing
    Set FSO = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:SendTestBuffer"
    Resume Release
    Resume
    
End Sub

'---------------------------------------------------------------------------------------
' Module    : BuildEltronTestBuffer
' DateTime  : 10/24/2006
' Author    : Chris Elwell
' Purpose   : Called from SendTestBuffer above if the printer type is Eltron.
'---------------------------------------------------------------------------------------
'
Private Function BuildEltronTestBuffer() As String

    On Error GoTo EH:
    
    Dim strLabel As String
    Dim strLblLength As String      'Label length
    Dim strOrientation As String    'Label Orientation
      
   'Set label length based on Thermal type in setup
    Select Case g_str187
        Case "199"                  '6 3/4" doc-tab label
            strLblLength = "Q1370, 24"
        Case "299"                  '6" non-doc-tab label
            strLblLength = "Q1218, 24"
        Case "399"                  '8" non-doc-tab label **does not yet exist!
            strLblLength = "Q1624, 24"
        Case "499"                  '8 3/4" doc-tab label **does not yet exist!
            strLblLength = "Q1776, 24"
    End Select
    
    'Set the label orientation command
    strOrientation = IIf(g_str1370 = "3", "ZB", "ZT")
    
   ' Formating Commands
    strLabel = "OD" & vbCrLf                    'Direct thermal mode
    strLabel = strLabel & "q812" & vbCrLf       'Width of label (4 X 203DPI)
    strLabel = strLabel & strLblLength & vbCrLf  'Length of label (6 3/4" doc-tab) and gap between labels
    strLabel = strLabel & "N" & vbCrLf          'Clear label buffer
    strLabel = strLabel & "D15" & vbCrLf        'Density - 15 = darkest print
    strLabel = strLabel & strOrientation & vbCrLf         'Print direction - bottom first
    'TEST LABEL text
    strLabel = strLabel & "A50,200,0,5,2,2,N," & Chr(34) & "TEST LABEL" & Chr(34) & vbCrLf
    'F12 key Barcode & text
    strLabel = strLabel & "A300,400,0,3,1,1,N," & Chr(34) & "[F12] Key" & Chr(34) & vbCrLf
    strLabel = strLabel & "B300,420,0,1,3,3,120,N," & Chr(34) & "F12" & Chr(34) & vbCrLf
    'ENTER key barcode & text
    strLabel = strLabel & "A300,800,0,3,1,1,N," & Chr(34) & "[ENTER] Key" & Chr(34) & vbCrLf
    strLabel = strLabel & "B300,820,0,1,3,3,120,N," & Chr(34) & vbCrLf & Chr(34) & vbCrLf

    BuildEltronTestBuffer = strLabel & "P1" & vbCrLf

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modCustomLabels:BuildEltronTestBuffer"

End Function
'---------------------------------------------------------------------------------------
' Module    : BuildZebraTestBuffer
' DateTime  : 10/24/2006
' Author    : Chris Elwell
' Purpose   : Called from SendTestBuffer above if the printer type is Eltron.
'---------------------------------------------------------------------------------------
'
Private Function BuildZebraTestBuffer() As String

    On Error GoTo EH:
    
    Dim strLabel As String
    Dim strLblLength As String      'Label length
    Dim strOrientation As String    'Label Orientation
    
    'Set the label orientation command - N Top first, I bottom first
    strOrientation = IIf(g_str1370 = "3", "N", "I")
    
   ' Formating Commands
    'strLabel = strLabel & strLblLength & vbCrLf  'Length of label (6 3/4" doc-tab) and gap between labels
    strLabel = "^XA^CF,0,0,0^PR12^MD30^PW800^PO" & strOrientation & Chr(10)
    'TEST PRINT text
    strLabel = strLabel & "^FO50,200^A0N,130,130^FWN^FH^FDTEST LABEL^FS" & Chr(10)
    'F12 key barcode & text
    strLabel = strLabel & "^FO300,400^A0N,20,18^FWN^FH^FD[F12] Key^FS" & Chr(10)
    strLabel = strLabel & "^FO300,420^BY2,3^BCN,120,N,N,N^FWN^FDF12^FS" & Chr(10)
    'ENTER key barcode & text
    strLabel = strLabel & "^FO300,800^A0N,20,18^FWN^FH^FD[ENTER] Key^FS" & Chr(10)
    strLabel = strLabel & "^FO300,820^BY2,3^BCN,120,N,N,N^FWN^FD" & vbCrLf & "^FS" & Chr(10)
    
    'Print command and end of buffer
    strLabel = strLabel & "^PQ1" & Chr(10)
    strLabel = strLabel & "^XZ" & Chr(10)


    BuildZebraTestBuffer = strLabel
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modCustomLabels:BuildZebraTestBuffer"

End Function
'---------------------------------------------------------------------------------------
' Procedure : LoadDistCenterCombo()
' DateTime  : 20070731-01 Updated with new hibs and hub IDs.
' Modified  : 20070827-02 Changed to Public, copied to modMain, added paramter MyCombo
' Purpose   : Loads the Distribution Center combo on the SmartPost/SP+ tab.
'---------------------------------------------------------------------------------------
'
Public Sub LoadDistCenterCombo(ByVal MyCombo As ComboBox)
    
    On Error GoTo EH
    
    MyCombo.AddItem "Atlanta - 5303"
    MyCombo.AddItem "Belleville - 5481"
    MyCombo.AddItem "Dallas - 5751"
    MyCombo.AddItem "Denver - 5802"
    MyCombo.AddItem "Florida - 5327"
    MyCombo.AddItem "Indianapolis - 5465"
    MyCombo.AddItem "Los Angeles - 5902"
    MyCombo.AddItem "Massachusetts - 5015"
    MyCombo.AddItem "Minneapolis - 5552"
    MyCombo.AddItem "New Berlin - 5531"
    MyCombo.AddItem "New Jersey - 5087"
    MyCombo.AddItem "North Carolina - 5281"
    MyCombo.AddItem "Ohio - 5431"
    MyCombo.AddItem "Philadelphia - 5194"
    MyCombo.AddItem "Phoenix - 5854"
    MyCombo.AddItem "Pittsburgh - 5150"
    MyCombo.AddItem "Sacramento - 5958"
    MyCombo.AddItem "San Francisco - 5948"
    MyCombo.AddItem "Seattle - 5983"
    MyCombo.AddItem "St. Louis - 5631"
    MyCombo.AddItem "West Virginia - 5254"

    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, "modMain.LoadDistCenterCombo"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : StripASCIIUnprintable()
' DateTime  : 200700829-01
' Purpose   : String ASCII < 32 and returns the result
'---------------------------------------------------------------------------------------
'
Public Function StripASCIIUnprintable(ByVal strString As String) As String
    
    On Error GoTo EH
    
    Dim i As Integer
    
    For i = 0 To 31
        strString = Replace(strString, Chr(i), "")
    Next
    
    StripASCIIUnprintable = strString
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, "modMain.StripASCIIUnprintable"

End Function
